home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
fortran
/
libry51.zip
/
LIBRY8A.DOC
< prev
next >
Wrap
Text File
|
1989-11-10
|
8KB
|
286 lines
.de
.pa
EXAMPLE OF HOW TO USE AND EVEN REDEFINE THERMODYNAMIC PROPERTY ROUTINES
$STORAGE:2
$DEBUG
PROGRAM PTEST
C
C test thermodynamic property routines
C developed by Dudley J. Benton, TVA Lab, Norris, (615) 632-1887
C
C This shows how to call each of the major thermodynamic routines
C and how to use them to define something other than KKHM water.
C
C If you remove the "*"s in column 1 at the bottom of the code and
C recompile you will get van der Waals EOS for steam (which, not
C surprisingly, doesn't work too well - especially for liquid
C states). Similarly, you can put in whatever EOS you want.
C
IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
CHARACTER SUBSTN*12
COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
&HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
CHARACTER ANS,CBUF*80
DIMENSION BUF(2)
C
100 CALL ERASE
WRITE(CBUF,1000) SUBSTN
1000 FORMAT('TESTING THERMODYNAMIC PROPERTIES: ',A12,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
CALL WRTTY(' 1. PSAT(TSAT)<')
CALL WRTTY(' 2. TSAT(PSAT)<')
CALL WRTTY(' 3. P,H,S(T,V)<')
CALL WRTTY(' 4. V,H,S(T,P)<')
CALL WRTTY(' 5. VF,VG,HF,HG,SF,SG(TSAT)<')
CALL WRTTY(' 6. T,V,S(P,H)<')
CALL WRTTY(' 7. T,V,H(P,S)<')
CALL WRTTY('<')
CALL WRTTY('select one of the above (or RETURN)_')
C
CALL READ1(ANS)
CALL ERASE
IF(ANS.EQ.'1') GO TO 200
IF(ANS.EQ.'2') GO TO 250
IF(ANS.EQ.'3') GO TO 300
IF(ANS.EQ.'4') GO TO 350
IF(ANS.EQ.'5') GO TO 400
IF(ANS.EQ.'6') GO TO 450
IF(ANS.EQ.'7') GO TO 500
IF(ANS.EQ.CHAR(13)) GO TO 999
CALL BEEP
GO TO 100
C
200 CALL WRTTY('enter TSAT _')
CALL STRING(BUF,1,IER)
IF(IER.NE.0) GO TO 100
T=BUF(1)
P=FPSAT(T)
WRITE(CBUF,2000) P
2000 FORMAT('PSAT=',F13.5,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 200
C
250 CALL WRTTY('enter PSAT _')
CALL STRING(BUF,1,IER)
IF(IER.NE.0) GO TO 100
P=BUF(1)
T=FTSAT(P)
WRITE(CBUF,2500) T
2500 FORMAT('TSAT=',F7.2,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 250
C
300 CALL WRTTY('enter T,V _')
CALL STRING(BUF,2,IER)
IF(IER.NE.0) GO TO 100
T=BUF(1)
V=BUF(2)
CALL TV2PHS(T,V,P,H,S)
WRITE(CBUF,3000) P,H,S
3000 FORMAT('P=',F13.5,' H=',F7.2,' S=',F8.5,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 300
C
350 CALL WRTTY('enter T,P _')
CALL STRING(BUF,2,IER)
IF(IER.NE.0) GO TO 100
T=BUF(1)
P=BUF(2)
CALL VOFTP(T,P,V,X,H,S,3)
WRITE(CBUF,3500) V,H,S
3500 FORMAT('V=',F13.5,' H=',F7.2,' S=',F8.5,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 350
C
400 CALL WRTTY('enter TSAT _')
CALL STRING(BUF,1,IER)
IF(IER.NE.0) GO TO 100
TSAT=BUF(1)
CALL VOFTP(TSAT,PSAT,VF,X,HF,SF,1)
WRITE(CBUF,2000) PSAT
CALL WRTTY(CBUF)
WRITE(CBUF,4000) VF,HF,SF
4000 FORMAT('VF=',F10.5,' HF=',F7.2,' SF=',F8.5,'<')
CALL WRTTY(CBUF)
CALL VOFTP(TSAT,PSAT,VG,X,HG,SG,2)
WRITE(CBUF,4100) VG,HG,SG
4100 FORMAT('VG=',F10.5,' HG=',F7.2,' SG=',F8.5,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 400
C
450 CALL WRTTY('enter P,H _')
CALL STRING(BUF,2,IER)
IF(IER.NE.0) GO TO 100
P=BUF(1)
H=BUF(2)
CALL TOFPH(T,P,V,X,H,S)
WRITE(CBUF,4500) T,V,X,S
4500 FORMAT('T=',F7.2,' V=',F13.5,' X=',F6.4,' S=',F8.5,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 450
C
500 CALL WRTTY('enter P,S _')
CALL STRING(BUF,2,IER)
IF(IER.NE.0) GO TO 100
P=BUF(1)
S=BUF(2)
CALL TOFPS(T,P,V,X,H,S)
WRITE(CBUF,5000) T,V,X,H
5000 FORMAT('T=',F7.2,' V=',F13.5,' X=',F6.4,' H=',F7.2,'<')
CALL WRTTY(CBUF)
CALL WRTTY('<')
GO TO 500
C
999 STOP
END
SUBROUTINE STRING(R,N,IER)
C
C READ A STRING OF NUMBERS FROM THE TERMINAL
C
IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
CHARACTER CBUF*20
DIMENSION R(N)
C
IER=0
IF(N.LT.1) GO TO 100
C
CALL READC(CBUF,20,IERR)
IF(IERR.NE.0) GO TO 100
C
NBUF=NBUFC1(CBUF,20)
IF(NBUF.EQ.0) GO TO 100
C
CALL DEC0DE(CBUF,NBUF,NCOL,R,N,IER)
GO TO 999
C
100 IER=1
C
999 RETURN
END
* SUBROUTINE TV2PHS(T,V,P,H,S)
C
C P,H,S AS FUNCTION OF T,V
C
C P....... PRESSURE [PSIA]
C H....... ENTHALPY [BTU/LBM]
C S....... ENTROPY [BTU/LBM/R]
C T....... TEMPERATURE [F]
C V....... SPECIFIC VOLUME [CU.FT/LBM]
C
* IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
* CHARACTER SUBSTN*12
* COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
* &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
* LOGICAL*2 FIRST
* COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
C
* IF(T.LT.TMIN.OR.V.LT.VMIN) THEN
* P=PMAX
* H=HMAX
* S=SMAX
* GO TO 999
* ENDIF
* IF(T.GT.TMAX.OR.V.GT.VMAX) THEN
* P=PMIN
* H=HMIN
* S=SMIN
* GO TO 999
* ENDIF
C
* CALL SETPRP
C
C this is van der Waals' Equation of State
C
* P=(RGAS*(T+459.67)/(V-BGAS)-AGAS/V/V)/144.
* H=HCRIT+(144.*(P*V-PCRIT*VCRIT)-AGAS*(1./V-1./VCRIT))/778.3
* &+CGAS*(T-TCRIT)
* S=SCRIT+ALOG((V-BGAS)/(VCRIT-BGAS))*RGAS/778.3
* &+CGAS*ALOG((T+459.67)/(TCRIT+459.67))
C
* 999 RETURN
* END
* FUNCTION FPSAT(TSAT)
C
C PSAT AS A FUNCTION OF TSAT
C
* IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
* CHARACTER SUBSTN*12
* COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
* &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
C
C BELOW TRIPLE POINT
C
* IF(TSAT.GT.TMIN) GO TO 100
* FPSAT=PMIN
* GO TO 999
C
C ABOVE CRITICAL POINT
C
* 100 IF(TSAT.LT.TCRIT) GO TO 200
* FPSAT=PCRIT
* GO TO 999
C
C this is not the right saturation pressure relationship for van der
C Waals so it won't come out right, but the correct one is much more
C complicated and requires iterative solution of simultaneous nonlinear
C equations
C
* 200 FPSAT=PCRIT*EXP((TCRIT-TSAT)/(TCRIT-212.)*ALOG(14.7/PCRIT))
C
* 999 RETURN
* END
* SUBROUTINE SETPRP
C
C put anything in here you want to initialize
C
* IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
* CHARACTER SUBSTN*12
* COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
* &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
* LOGICAL*2 FIRST
* COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
C
* IF(.NOT.FIRST) GO TO 999
* FIRST=.FALSE.
* RGAS=1545.3/WMOL
* BGAS=RGAS*(TCRIT+459.67)/8./PCRIT/144.
* AGAS=27.*RGAS*(TCRIT+459.67)*BGAS/8.
* VCRIT=3.*BGAS
* ZCRIT=3./8.
* VMIN=1.01*BGAS
C
* 999 RETURN
* END
* BLOCK DATA
* IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
* CHARACTER SUBSTN*12
* COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
* &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
* LOGICAL*2 FIRST
* COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
C
C initialize variables in /TPROPS/
C
* DATA SUBSTN/'vd Waals H2O'/
* DATA TMIN,PMIN,VMIN,HMIN,SMIN/32.018,.08866,.015,0.,-.005/
* DATA TMAX,PMAX,VMAX,HMAX,SMAX/2400.,20000.,10000.,2400.,3./
* DATA TCRIT,PCRIT,VCRIT,HCRIT,SCRIT/705.44,3203.6,.050531,
* &902.5,1.058/
* DATA WMOL/18.016/
C
C initialize variables in /VANDER/
C
* DATA FIRST,CGAS/.TRUE.,.445/
C
* END
.ee